home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FM Towns: Free Software Collection 4
/
FM Towns Free Software Collection 4 - Disc 1.iso
/
fb386
/
bdbc_b
/
bdbc_b.bas
next >
Wrap
BASIC Source File
|
1991-10-18
|
3KB
|
86 lines
10 CLS
20 LOCATE 10,0:PRINT "Black Tool Series vol.2"
30 LOCATE 0,1:PRINT "Black Dump Basic Convarter V1.1L10b"
40 WAIT 100
50 CLS
10000 CONSOLE 0,0,1
10100 COLOR 7,0,0
10200 PRINT "読み込むファイル名を拡張子を付けて入力してください(パス名などは入力しないで下さい)"
10300 INPUT "",FILENA1$:CLS:IF FILENA1$="" THEN END ELSE IF LEN(FILENA1$)>8 THEN 10200
10400 COLOR 0,0
10500 ON ERROR GOTO *FILE_E1:FILES FILENA1$
10600 COLOR 7,0:CLS:ON ERROR GOTO 0
10700 PRINT "新しく書き込むファイル名をディスク名、パス名を付けて入力してください(カレントは省略 可:拡張子はいりません)"
10800 INPUT "",FILENA2$:CLS:IF FILENA2$="" THEN 10000
10900 COLOR 0,0:FILENA2$=FILENA2$+".BAS"
11000 ON ERROR GOTO 11200:FILES FILENA2$
11100 COLOR 7,0:CLS:ON ERROR GOTO 0:GOTO *FILE_E2
11200 RESUME 11300
11300 ON ERROR GOTO 0
11400 FILENA1$="(1)"+FILENA1$
11500 COLOR 7,0:OPEN "R",#1,FILENA1$
11600 OPEN "O",#2,FILENA2$
11700 PRINT #2," 10 'BMBC V1.1"
11800 PRINT #2," 20 CLS:FILENA$="+CHR$(&H22)+FILENA1$+CHR$(&H22)
11900 FIELD #1,1 AS G$
12000 RESTORE 17000
12100 FOR I=0 TO 10
12200 IF I=1 LI$=" 40 OPEN "+CHR$(&H22)+"R"+CHR$(&H22)+",#1,FILENA$" ELSE IF I=4 THEN LI$=" 70 READ A$:A$="+CHR$(&H22)+"&H"+CHR$(&H22)+"+A$:A=VAL(A$):A$=CHR$(A)" ELSE READ LI$
12300 PRINT#2,LI$
12400 NEXT I
12500 LMAX=LOF(1)
12600 PRINT #2,"140 DATA"+STR$(LMAX)
12700 IMAX=LMAX \ 20
12800 AMARI=LMAX-(IMAX*20):L=150
12900 IF IMAX=0 THEN 14100
13000 FOR I=1 TO IMAX
13100 P2$="":P1$="":FOR M=1 TO 19
13200 GET #1:G=ASC(G$):P1$=HEX$(G)
13300 IF LEN(P1$)=1 THEN P1$="0"+P1$
13400 P2$=P2$+P1$+","
13500 NEXT M
13600 GET#1:G=ASC(G$):P1$=HEX$(G)
13700 IF LEN(P1$)=1 THEN P1$="0"+P1$
13800 P2$=P2$+P1$
13900 PRINT#2,STR$(L)+" DATA "+P2$
14000 L=L+10:NEXT I
14100 IF AMARI=0 THEN 15200
14200 IF AMARI=1 THEN 14800
14300 P1$="":P2$="":FOR I=1 TO AMARI-1
14400 GET #1:G=ASC(G$):P1$=HEX$(G)
14500 IF LEN(P1$)=1 THEN P1$="0"+P1$
14600 P2$=P2$+P1$+","
14700 NEXT I
14800 GET #1:G=ASC(G$):P1$=HEX$(G)
14900 IF LEN(P1$)=1 THEN P1$="0"+P1$
15000 P2$=P2$+P1$
15100 PRINT#2,STR$(L)+" DATA "+P2$
15200 CLOSE:BEEP
15300 END
15400 *FILE_E1
15500 BEEP:COLOR 7,0
15600 PRINT FILENA1$+"は存在しません"
15700 PRINT "何かキーを押して下さい。":WAIT 10
15800 WHILE INKEY$="":WEND:RESUME 10000
15900 *FILE_E2
16000 BEEP:COLOR 7,0
16100 PRINT FILENA2$+"は既に存在しています。"
16200 PRINT "上書きしますか?(Y/N)"
16300 WAIT 10
16400 K$=INKEY$
16500 IF K$="Y" OR K$="y" THEN 16800
16600 IF K$="N" OR K$="n" THEN 10600
16700 GOTO 16400
16800 KILL FILENA2$
16900 GOTO 11300
17000 DATA " 30 RESTORE:READ LMAX
17100 DATA " 50 FIELD #1,1 AS P$
17200 DATA " 60 FOR I=1 TO LMAX
17300 DATA
17400 DATA " 80 LSET P$=A$
17500 DATA " 90 PUT#1,I
17600 DATA " 100 NEXT I
17700 DATA " 110 CLOSE
17800 DATA " 120 BEEP
17900 DATA " 130 END